home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / piblist.arc / INIT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-03-29  |  11.9 KB  |  367 lines
  1. (*----------------------------------------------------------------------*)
  2. (*               Init_File --- Initialize File to be listed             *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Init_File( VAR File_Spec: AnyStr; VAR CC_Given: AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*   Procedure:   Init_File                                             *)
  10. (*                                                                      *)
  11. (*   Purpose:     Initializes File to be listed                         *)
  12. (*                                                                      *)
  13. (*   Calling sequence:                                                  *)
  14. (*                                                                      *)
  15. (*      Init_File( VAR File_Spec: AnyStr; VAR CC_Given: AnyStr );       *)
  16. (*                                                                      *)
  17. (*         File_Spec: Name of file to be listed.                        *)
  18. (*         CC_Given:  Carriage_control type.                            *)
  19. (*                                                                      *)
  20. (*   Calls:  ClrScr                                                     *)
  21. (*           Clear_Screen                                               *)
  22. (*           ClrEol                                                     *)
  23. (*           Delay                                                      *)
  24. (*           Halt                                                       *)
  25. (*           GoToXY                                                     *)
  26. (*           Reset                                                      *)
  27. (*           IOResult                                                   *)
  28. (*           Read_Command                                               *)
  29. (*           Skipbl                                                     *)
  30. (*           TextMode                                                   *)
  31. (*           TextColor                                                  *)
  32. (*           Min                                                        *)
  33. (*           Max                                                        *)
  34. (*           GetFileSpec                                                *)
  35. (*                                                                      *)
  36. (*   Remarks:                                                           *)
  37. (*                                                                      *)
  38. (*      A prompt is issued for the desired file name and its            *)
  39. (*      carriage-control characteristics.  An empty file causes         *)
  40. (*      PibList to halt.                                                *)
  41. (*                                                                      *)
  42. (*----------------------------------------------------------------------*)
  43.  
  44. VAR
  45.    OK_File:      BOOLEAN;
  46.  
  47. (*----------------------------------------------------------------------*)
  48.  
  49. PROCEDURE GetFileSpec;
  50.  
  51. BEGIN (* GetFileSpec *)
  52.  
  53.    Textcolor( Help_Text_Color );
  54.    ClrScr;
  55.    GoToXY( 5 , 8 );
  56.  
  57.    WRITE('Enter name of file to be listed: ');
  58.  
  59.                                    (* Read file name *)
  60.    READLN( File_Spec );
  61.  
  62.                                    (* Check if any file name entered. *)
  63.  
  64.    IF LENGTH(File_Spec) <= 0 THEN
  65.       BEGIN
  66.          TextColor( Help_Text_Color + Blink );
  67.          WRITELN;
  68.          WRITELN('    >>>>> No file name entered, program halts.');
  69.          TextColor( ForeGround_Color );
  70.          Delay( 4000 );
  71.          Clear_Screen;
  72.          Halt;
  73.       END;
  74.  
  75. END   (* GetFileSpec *);
  76.  
  77. (*----------------------------------------------------------------------*)
  78.  
  79. BEGIN (* Init_File *)
  80.  
  81.    OK_File := FALSE;
  82.  
  83.    IF LENGTH( File_Spec ) <= 0 THEN    (* Prompt for name of file to list *)
  84.       GetFileSpec;
  85.  
  86.  
  87.    REPEAT
  88.                                    (* Attach file to be listed *)
  89.       Assign( f, File_Spec );
  90.  
  91.       (*$I- *)
  92.          Reset( F );
  93.       (*$I+ *)
  94.  
  95.       IF IOresult <> 0 THEN
  96.          BEGIN
  97.             Textcolor( Help_Text_Color + Blink );
  98.             WRITELN;
  99.             WRITELN('    >>>>> Can''t find file ',File_Spec);
  100.             TextColor( ForeGround_Color );
  101.             Delay( 4000 );
  102.             Clear_Screen;
  103.             GetFileSpec;
  104.          END
  105.       ELSE
  106.          OK_File := TRUE;
  107.  
  108.    UNTIL( OK_File );
  109.                                     (* Set file for reading *)
  110.    Reset_F;
  111.                                     (* Pick up FCB address of F *)
  112.    F_Ptr := Addr( F );
  113.  
  114.                                     (* Empty file -- quit *)
  115.    IF EOF( F ) THEN
  116.       BEGIN
  117.          Textcolor( Help_Text_Color + Blink );
  118.          WRITELN;
  119.          WRITELN('    >>>>> File ', File_Spec,' is empty');
  120.          Textcolor( ForeGround_Color );
  121.          Delay( 4000 );
  122.          Clear_Screen;
  123.          Halt;
  124.       END;
  125.                                     (* Check up carriage control type *)
  126.  
  127.    IF ( CC_Given <> ''     ) AND
  128.       ( CC_Given <> 'LPC'  ) AND
  129.       ( CC_Given <> 'FF'   ) AND
  130.       ( CC_Given <> 'NONE' ) THEN
  131.       BEGIN
  132.  
  133.          Textcolor( Help_Text_Color );
  134.          GoToXY( 5 , 9 );
  135.          ClrEol;
  136.          WRITE('Enter carriage control characteristics (CC,LIST,NONE)');
  137.  
  138.          Read_Command;
  139.          Skipbl;
  140.  
  141.          CC_Given := '';
  142.  
  143.          WHILE( ( cind <= Max_String ) AND ( command[cind] <> nul ) ) DO
  144.             BEGIN
  145.                CC_Given := CC_Given + UPCASE(command[cind]);
  146.                cind     := cind + 1;
  147.             END;
  148.  
  149.       END;
  150.  
  151.    lpt  := FALSE;
  152.    nocc := TRUE;
  153.  
  154.    IF CC_Given = 'LPC' THEN
  155.       BEGIN
  156.          lpt  := TRUE;
  157.          nocc := FALSE;
  158.       END
  159.    ELSE IF CC_Given = 'FF' THEN
  160.       nocc := FALSE;
  161.  
  162. END   (* Init_File *);
  163.  
  164. (*----------------------------------------------------------------------*)
  165. (*               Initialize --- Initialize PibList Program              *)
  166. (*----------------------------------------------------------------------*)
  167.  
  168. PROCEDURE Initialize;
  169.  
  170. (*----------------------------------------------------------------------*)
  171. (*                                                                      *)
  172. (*   Procedure:   Initialize                                            *)
  173. (*                                                                      *)
  174. (*   Purpose:     Initializes PibList program execution                 *)
  175. (*                                                                      *)
  176. (*   Calling sequence:                                                  *)
  177. (*                                                                      *)
  178. (*      Initialize;                                                     *)
  179. (*                                                                      *)
  180. (*   Calls:  Get_Screen_Address                                         *)
  181. (*           Set_Global_Colors                                          *)
  182. (*           Init_File                                                  *)
  183. (*           Read_Line                                                  *)
  184. (*           TextMode                                                   *)
  185. (*           TextColor                                                  *)
  186. (*           Min                                                        *)
  187. (*           Max                                                        *)
  188. (*           FillChar                                                   *)
  189. (*                                                                      *)
  190. (*----------------------------------------------------------------------*)
  191.  
  192. VAR
  193.    i:         INTEGER;
  194.    j:         INTEGER;
  195.    k:         INTEGER;
  196.    len:       INTEGER;
  197.    last_col:  INTEGER;
  198.    p:         Line_Ptr;
  199.    CC_Given:  AnyStr;
  200.    File_Spec: AnyStr;
  201.    Param_Str: AnyStr;
  202.  
  203. BEGIN  (* Initialize *)
  204.  
  205.    Max_line    := 0;
  206.    Max_page    := 0;
  207.    done        := FALSE;
  208.    eod         := FALSE;
  209.    lpt         := FALSE;
  210.    width       := 80;
  211.    Expand_Tabs := FALSE;
  212.    Strip_High  := FALSE;
  213.    File_Spec   := '';
  214.    CC_Given    := '';
  215.    Eject_Char  := CHR(255);
  216.  
  217.    spec_chars := [#0..#31,#127];
  218.  
  219.                                    (* Get the circular text line buffer *)
  220.    NEW( First );
  221.  
  222.    Last := First;
  223.  
  224.    FOR i := 1 TO Max_buf_lines-1 DO
  225.       BEGIN
  226.          NEW( p );
  227.          last^.next := p;
  228.          last       := p
  229.       END;
  230.  
  231.    last^.next := first;
  232.    last       := nil;
  233.  
  234.                                    (* Select color/mono screen *)
  235.  
  236.    Get_Screen_Address( Real_Screen );
  237.  
  238.                                    (* Establish colors         *)
  239.  
  240.    IF Color_Screen_Active THEN
  241.       BEGIN
  242.  
  243.          ForeGround_Color  := Yellow     (* Color for ordinary text  *);
  244.          BackGround_Color  := Black      (* Usual background color   *);
  245.  
  246.          Help_Text_Color   := Red        (* Color for help text      *);
  247.          Spec_Chars_Color  := Green      (* Color for spec. chars    *);
  248.          Status_Line_Color := Blue       (* Status line color        *);
  249.          Search_Text_Color := Green      (* Color for searched text  *);
  250.  
  251.          TextMode ( C80    );
  252.  
  253.       END
  254.    ELSE
  255.       BEGIN
  256.  
  257.          ForeGround_Color  := White      (* Color for ordinary text  *);
  258.          BackGround_Color  := Black      (* Usual background color   *);
  259.  
  260.          Help_Text_Color   := White      (* Color for help text      *);
  261.          Spec_Chars_Color  := White      (* Color for spec. chars    *);
  262.          Status_Line_Color := Black      (* Color for status line    *);
  263.          Search_Text_Color := White + 128 (* Color for searched text *);
  264.  
  265.          TextMode ( BW80  );
  266.  
  267.       END;
  268.  
  269.    Set_Global_Colors( ForeGround_Color, BackGround_Color );
  270.  
  271.    TextColor( ForeGround_Color );
  272.    TextBackGround( BackGround_Color );
  273.  
  274.                                    (* Scan for parameters *)
  275.  
  276.    FOR I := 1 TO ParamCount DO
  277.       BEGIN
  278.  
  279.          Param_Str := ParamStr( I );
  280.  
  281.          IF Param_Str[1] <> '/' THEN
  282.             File_Spec := Param_Str
  283.          ELSE
  284.  
  285.             CASE UpCase( Param_Str[2] ) OF
  286.  
  287.                'T': Expand_Tabs := TRUE;
  288.                'H': Strip_High  := TRUE;
  289.                'L': IF UpCase( Param_Str[3] ) = 'P' THEN
  290.                        CC_Given := 'LPC';
  291.                'F': IF UpCase( Param_Str[3] ) = 'F' THEN
  292.                        CC_Given := 'FF';
  293.  
  294.                ELSE ;
  295.  
  296.             END (* CASE *);
  297.  
  298.       END;
  299.  
  300.                                    (* Get the file name to list and open it *)
  301.  
  302.    Init_file( File_Spec , CC_Given );
  303.  
  304.                                    (* Choose FF or '1' as page marker *)
  305.  
  306.    IF ( NOT nocc ) THEN
  307.       IF lpt THEN eject_char := '1' ELSE eject_char := FF;
  308.  
  309.    i        := 1;
  310.    last_col := 1;
  311.                                    (* Read in the first Max_Buf_Lines lines *)
  312.    REPEAT
  313.  
  314.       Read_Line;
  315.  
  316.       i  := i + 1;
  317.  
  318.       last_col := MAX( last_col , LENGTH( last^.Txt ) );
  319.  
  320.    UNTIL ( i = Max_buf_lines ) OR EOF( F );
  321.  
  322.    Top := First;
  323.  
  324.    IF lpt THEN j := 2 ELSE j := 1;
  325.  
  326.    IF last_col <= width THEN
  327.       first_col := j
  328.    ELSE
  329.       BEGIN
  330.  
  331.          p := first;
  332.          k := Max_String + 1;
  333.  
  334.          REPEAT
  335.  
  336.             i := j;
  337.  
  338.             WITH p^ DO
  339.                BEGIN
  340.  
  341.                   len := LENGTH( p^.Txt );
  342.  
  343.                   WHILE ( i < len ) AND ( txt[i] IN [' ',ff] ) DO i := i + 1;
  344.  
  345.                   IF i < len THEN k := MIN( k , i )
  346.  
  347.                END;
  348.  
  349.             p := p^.next
  350.  
  351.          UNTIL p = last^.next;
  352.  
  353.          first_col := MIN( k , last_col + j - width );
  354.  
  355.      END;
  356.  
  357.                                    (* No current search string *)
  358.    Search_Str  := '';
  359.    Search_Line := 0;
  360.    Search_Lpos := 0;
  361.    Search_Col  := 0;
  362.  
  363.    One_Up      := FALSE;
  364.    One_Down    := FALSE;
  365.  
  366. END   (* Initialize *);
  367.